home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Libraries & Documentation
/
Add-ons
/
Graphic effects
/
ProgressBar.p
< prev
Wrap
Text File
|
1995-09-10
|
10KB
|
337 lines
{Adaptive progress bar unit}
{by Ingemar Ragnemalm 1995}
{This unit draws a progress bar (for giving the user visual feedback during a long}
{modal operation) in the current port. It works in color if available.}
{The difference between this and other progress bars is that this one is ADAPTIVE,}
{giving accurate time indications rather than the number of operations or some}
{arbitrary length.}
{You initialize the bar with InitProgressBar, which gives you a pointer to it data.}
{Call AdvanceProgressBar repeatedly during your lengthy operation. Note that you}
{do NOT tell how far it should move each time. AdvanceProgressBar will calculate}
{that for you from the current time. When your lengthy operation is finished, call}
{FinishProgressBar. It will dispose of the pointer and store the final time in the}
{preference folder.}
{The first time you run a progress bar, you get a "barber pole" bar, indicating that}
{the expected time is unknown. After that, the time elapsed will be stored, so}
{later progress bars will be accurate. The progress bar is shown if the resource}
{with the expected time did not exist.}
{Notes:}
{You must provide the resource fork to your OPEN preference file for storing}
{the total time.}
{If you use several different progress bars, you should use different resID, so that}
{they can store different times.}
unit ProgressBar;
interface
{$ifc UNDEFINED THINK_PASCAL}
uses
Types, QuickDraw, Memory, Resources, ToolUtils;
{$endc}
type
ProgressBarResRec = record
totalTime: Longint; {Expected time}
end;
ProgressBarResPtr = ^ProgressBarResRec;
ProgressBarResHnd = ^ProgressBarResPtr;
ProgressBarColorRec = record
frame, fore, back: RGBColor;
end;
ProgressBarColorPtr = ^ProgressBarColorRec;
ProgressBarRec = record
prefFile: Integer; {File number of the preference file}
resID: Integer; {What resource number should the expected time resource have?}
bounds: Rect; {The rectangle in which to draw.}
colors: ProgressBarColorPtr; {What colors to use?}
hasColorQD: Boolean;
port: GrafPtr; {In what port?}
dev: GDHandle; {What device? (Most likely the main device.)}
startTicks: Longint; {When did we start?}
lastLimit: Integer; {Up to what point did we draw last time?}
res: ProgressBarResHnd; {Resource in which the expected time i stored.}
end;
ProgressBarPtr = ^ProgressBarRec;
function InitProgressBar (prefFile, resID: Integer; bounds: Rect; colors: ProgressBarColorPtr): ProgressBarPtr;
function ProgressBarColors (frameRed, frameGreen, frameBlue, backRed, backGreen, backBlue, foreRed, foreGreen, foreBlue: Integer): ProgressBarColorPtr;
function ProgressBarColorsRGB (frame, back, fore: RGBColor): ProgressBarColorPtr;
procedure AdvanceProgressBar (thePB: ProgressBarPtr);
procedure FinishProgressBar (thePB: ProgressBarPtr);
{InitProgressBar: Sets up a progress bar and returns a pointer to it.}
{Parameter:}
{prefFile: File number of an open resource file in which to store preferences.}
{resID: Resource number for the resource in which to save. You should use a different number}
{ for every progress bar your program uses}
{bounds: The rectangle in which to draw (locl coordinates in the current port).}
{colors: Colors to draw with. Use nil for default colors.}
{ProgressBarColor and ProgressBarColorsRGB: Sets up a color record.}
{AdvanceProgressBar: Updates the progress bar. The pointer to the progress bar is the only}
{ parameter.}
{FinishProgressBar: Dispose the progress bar. It fills the progress bar to indicate that the}
{ operation is completed, but does NOT erase it. The pointer to the}
{ progress bar is the only parameter.}
implementation
const
kProgressResType = 'PrgB';
var
latest: ProgressBarPtr;
function MakeColor (red, green, blue: Integer): RGBColor;
var
theColor: RGBColor;
begin
theColor.red := red;
theColor.green := green;
theColor.blue := blue;
MakeColor := theColor;
end; {MakeColor}
function RectWidth (r: Rect): integer;
begin
RectWidth := r.right - r.left;
end;
function RectHeight (r: Rect): integer;
begin
RectHeight := r.bottom - r.top;
end;
function ProgressBarColors (frameRed, frameGreen, frameBlue, backRed, backGreen, backBlue, foreRed, foreGreen, foreBlue: Integer): ProgressBarColorPtr;
var
theColors: ProgressBarColorPtr;
begin
theColors := ProgressBarColorPtr(NewPtr(SizeOf(ProgressBarColorRec)));
theColors^.frame.red := frameRed;
theColors^.frame.green := frameGreen;
theColors^.frame.blue := frameBlue;
theColors^.back.red := backRed;
theColors^.back.green := backGreen;
theColors^.back.blue := backBlue;
theColors^.fore.red := foreRed;
theColors^.fore.green := foreGreen;
theColors^.fore.blue := foreBlue;
ProgressBarColors := theColors;
end; {ProgressBarColors}
function ProgressBarColorsRGB (frame, back, fore: RGBColor): ProgressBarColorPtr;
var
theColors: ProgressBarColorPtr;
begin
theColors := ProgressBarColorPtr(NewPtr(SizeOf(ProgressBarColorRec)));
theColors^.frame := frame;
theColors^.back := back;
theColors^.fore := fore;
ProgressBarColorsRGB := theColors;
end; {ProgressBarColorsRGB}
function InitProgressBar (prefFile, resID: Integer; bounds: Rect; colors: ProgressBarColorPtr): ProgressBarPtr;
var
thePB: ProgressBarPtr;
ser: SysEnvRec;
saveColor: RGBColor;
saveResFile: Integer;
i: Integer;
begin
thePB := ProgressBarPtr(NewPtrClear(SizeOf(ProgressBarRec)));
if thePB <> nil then
begin
if SysEnvirons(1, ser) = noErr then
thePB^.hasColorQD := ser.hasColorQD;
thePB^.colors := colors;
if thePB^.hasColorQD then
if colors = nil then
thePB^.colors := ProgressBarColors(0, 0, 0, $C000, $C000, $C000, $6000, $6000, $E000);
if thePB^.hasColorQD then
GetForeColor(saveColor);
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.back);
PaintRect(bounds);
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.frame)
else
ForeColor(blackColor);
FrameRect(bounds);
if thePB^.hasColorQD then
RGBForeColor(saveColor);
GetPort(thePB^.port);
if thePB^.hasColorQD then
thePB^.dev := GetGDevice;
thePB^.prefFile := prefFile;
thePB^.resID := resID;
thePB^.bounds := bounds;
saveResFile := CurResFile;
UseResFile(thePB^.prefFile);
thePB^.res := ProgressBarResHnd(GetResource(kProgressResType, resID));
UseResFile(saveResFile);
if thePB^.res = nil then
for i := 1 to 15 do
AdvanceProgressBar(thePB);
thePB^.lastLimit := 1;
thePB^.startTicks := TickCount;
end;
latest := thePB;
InitProgressBar := thePB;
end; {InitProgressBar}
procedure AdvanceProgressBar (thePB: ProgressBarPtr);
var
nowTicks: Longint;
r: Rect;
nowLimit, h: Integer;
saveColor: RGBColor;
i: Integer;
saveClip: RgnHandle;
savePort: GrafPtr;
saveDevice: GDHandle;
begin
if thePB = nil then
thePB := latest;
if thePB = nil then
Exit(AdvanceProgressBar);
latest := thePB;
GetPort(savePort);
saveDevice := GetGDevice;
SetPort(thePB^.port);
if thePB^.hasColorQD then
SetGDevice(thePB^.dev);
if thePB^.hasColorQD then
GetForeColor(saveColor);
if thePB^.res = nil then {Barber pole}
begin
thePB^.lastLimit := (thePB^.lastLimit + 1) mod 30;
h := RectHeight(thePB^.bounds) - 3;
r := thePB^.bounds;
InsetRect(r, 1, 1);
saveClip := NewRgn;
GetClip(saveClip);
ClipRect(r);
for i := 0 to RectWidth(thePB^.bounds) div 30 do
begin
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.back)
else
ForeColor(whiteColor);
MoveTo(i * 30 + thePB^.lastLimit, thePB^.bounds.bottom - 2);
Line(h, -h);
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.fore)
else
ForeColor(blackColor);
MoveTo(i * 30 + 15 + thePB^.lastLimit, thePB^.bounds.bottom - 2);
Line(h, -h);
end;
SetClip(saveClip);
DisposeRgn(saveClip);
end
else
begin
nowTicks := TickCount;
r := thePB^.bounds;
r.left := thePB^.bounds.left + thePB^.lastLimit;
nowLimit := RectWidth(thePB^.bounds) * (nowTicks - thePB^.startTicks) div thePB^.res^^.totalTime;
if nowLimit = thePB^.lastLimit then
begin
end;
if nowLimit < thePB^.lastLimit then
begin
end;
if nowLimit > RectWidth(thePB^.bounds) - 2 then
nowLimit := RectWidth(thePB^.bounds) - 2;
r.right := thePB^.bounds.left + nowLimit;
r.top := thePB^.bounds.top + 1;
r.bottom := thePB^.bounds.bottom - 1;
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.fore);
PaintRect(r);
thePB^.lastLimit := nowLimit;
end;
if thePB^.hasColorQD then
RGBForeColor(saveColor);
SetPort(savePort);
SetGDevice(saveDevice);
end; {AdvanceProgressBar}
procedure FinishProgressBar (thePB: ProgressBarPtr);
var
finalTicks: Longint;
saveResFile: Integer;
r: Rect;
saveColor: RGBColor;
savePort: GrafPtr;
saveDevice: GDHandle;
begin
if thePB = nil then
thePB := latest;
if thePB = nil then
Exit(FinishProgressBar);
GetPort(savePort);
saveDevice := GetGDevice;
SetPort(thePB^.port);
if thePB^.hasColorQD then
SetGDevice(thePB^.dev);
if thePB^.hasColorQD then
GetForeColor(saveColor);
finalTicks := TickCount;
saveResFile := CurResFile;
UseResFile(thePB^.prefFile);
if thePB^.res = nil then
begin
thePB^.res := ProgressBarResHnd(NewHandle(SizeOf(ProgressBarResRec)));
AddResource(Handle(thePB^.res), kProgressResType, thePB^.resID, 'Progress bar data');
end
else
begin
r.left := thePB^.bounds.left + thePB^.lastLimit;
r.right := thePB^.bounds.right - 1;
r.top := thePB^.bounds.top + 1;
r.bottom := thePB^.bounds.bottom - 1;
if thePB^.hasColorQD then
RGBForeColor(thePB^.colors^.fore);
PaintRect(r);
end;
thePB^.res^^.totalTime := finalTicks - thePB^.startTicks;
ChangedResource(Handle(thePB^.res));
UpdateResFile(thePB^.prefFile);
UseResFile(saveResFile);
if thePB^.hasColorQD then
RGBForeColor(saveColor);
if thePB^.colors <> nil then
DisposePtr(Ptr(thePB^.colors));
DisposePtr(Ptr(thePB));
latest := nil;
SetPort(savePort);
SetGDevice(saveDevice);
end; {FinishProgressBar}
end.